home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr08 / hsd115b4.zip / _HOST.WAS next >
Text File  |  1995-03-09  |  49KB  |  1,486 lines
  1. ;Host Mode script v2.00
  2. ;Modified 3/10/95 by Samuel H. Smith to include HS/Link protocol
  3.  
  4. ;**** THIS FILE BELONGS IN \PROWIN2\ASPECT\HOST\_HOST.WAS
  5. ;**** REMEMBER TO COMPILE BEFORE RUNNING THE FIRST TIME!
  6.  
  7. ;***********************************************************************
  8. ;*                                                                     *
  9. ;* _HOST.WAS                                                           *
  10. ;* Copyright (C) 1992-1994 Datastorm Technologies, Inc.                *
  11. ;* All rights reserved.                                                *
  12. ;*                                                                     *
  13. ;* Purpose: Provides an interface for a remote user to send and        *
  14. ;*          receive files and electronic mail.  Also provides fax      *
  15. ;*          send capability for faxmodems.                             *
  16. ;*                                                                     *
  17. ;* Version: 2.0                                                        *
  18. ;*                                                                     *
  19. ;***********************************************************************
  20.  
  21. ;***********************************************************************
  22. ;*                                                                     *
  23. ;*  WARNING!                                                           *
  24. ;*                                                                     *
  25. ;*  Do not modify this script file unless you have a good under-       *
  26. ;*  standing of the Windows ASPECT language.  If you do modify this    *
  27. ;*  script, PLEASE MAKE A BACKUP before doing so.                      *
  28. ;*                                                                     *
  29. ;***********************************************************************
  30.  
  31. ;***********************************************************************
  32. ;*                                                                     *
  33. ;*   MACRO DEFINITIONS                                                 *
  34. ;*                                                                     *
  35. ;***********************************************************************
  36. #define FALSE 0         ; Boolean variables
  37. #define TRUE  1         ;
  38.  
  39. #define NAMEMAX  48     ; maximum length for user name
  40. #define PSWDMAX  8      ; maximum user passwrd length
  41.  
  42. #define DISP 1          ; show characters for input
  43. #define MASK 0          ; hide characters for password input
  44.  
  45. #define MODEM_CON    0  ; Connection type is a MODEM
  46. #define DIRECT_CON   1  ; Connection type is direct cable / no MODEM
  47.  
  48. #define OPEN_SYSTEM   0 ; anyone can login
  49. #define CLOSED_SYSTEM 1 ; only users already in the HOST.USR can login
  50.  
  51. ; access_level levels for users
  52. #define NEWUSER      0  ; new - can't do file xfers
  53. #define REGUSER      1  ; normal-can do file xfers to upload/download areas
  54. #define SUPERUSER    2  ; super-can do file xfers to/from any drive/directory
  55.  
  56. #define FLD_SEP    59   ; Field separator is ACSII 59 (semi-colon)
  57.  
  58. #define _HOST_INCLUDE_
  59.  
  60. #define HOSTUSRFILE  "HOST.USR"  ; User data file
  61. #define HOSTLOGFILE  "HOST.LOG"  ; Log of Host activity
  62. #define HOSTPRMFILE  "HOST.PRM"  ; Parameter file
  63. #define HOSTHLPFILE  "HOST.HLP"  ; Help file
  64. #define HOSTNWSFILE  "HOST.NWS"  ; News file
  65. #define HOSTNUFILE   "HOST.NUF"  ; New user file
  66. #define HOSTDNLDFILE "HOST.DNL"  ; Download file list
  67.  
  68. ;Mail Defines
  69. #define HOSTMSGFILE  "HOST.MSG"  ; Mail message file
  70. #define HOSTHDRFILE  "HOST.HDR"  ; Mail header file
  71. #define PUBLIC     0             ; Mail message flags
  72. #define PRIVATE    1             ;
  73. #define NEWMAIL    2             ;
  74. #define DELETED    4             ;
  75.  
  76. ;***********************************************************************
  77. ;*                                                                     *
  78. ;*   GLOBAL VARIABLES                                                  *
  79. ;*                                                                     *
  80. ;***********************************************************************
  81.  
  82. ;PATH VARIABLES
  83. string hostupload_path, hostdnload_path, hostfax_path
  84.  
  85. ;FILE VARIABLES
  86. string logfile, parmfile, usrfile, newsfile, hlpfile, dnldfile
  87. string hdrfile, msgfile, tempfile, nufile, pwhelp_file
  88.  
  89. ;HOST SYSTEM STRINGS
  90. string welcome_msg,  ontime, offtime, name, msg, pswrd
  91. string _time, _date, message, searchstr, title
  92.  
  93. ;HOST SYSTEM FLAGS
  94. integer new_usr_level, connect_type, system_type, goodbye_option
  95. integer local_logon, jump, sysop, already_running, OKtoChat, chatflag
  96. integer fNewUserFax, fAnswerFax, OldAnswerMode, distinctive_ring
  97.  
  98. ;PROCOMM PLUS
  99. integer old_menu, new_menu, tempkey, status, msg_number
  100. integer meta_status, quick_status
  101. string action1, action2, action3, action4, action5
  102.  
  103. ;USER RECORD VARIABLES - see USER.WAS for details
  104. string   LoginName
  105. integer  Security
  106. string   Passwrd
  107. string   UserUploadPath
  108. string   UserDnloadPath
  109. integer  fDirectory
  110. integer  fCallback
  111. integer  fFaxBack
  112. string   Note
  113. string   CallBackNum
  114. integer  CallNumber
  115. long     LastCalled
  116. integer  LastMsgRead
  117.  
  118. ;***********************************************************************
  119. ;*                                                                     *
  120. ;* MAIN                                                                *
  121. ;*                                                                     *
  122. ;* This is the main program loop.                                      *
  123. ;*                                                                     *
  124. ;* Calls: SAVE_PRM, HOSTSETUP, HOSTLOG, WAITFORCALL,  GETUSER,         *
  125. ;*        DISPLAYFILE, CHECKMAIL, HOSTMENU                             *
  126. ;*                                                                     *
  127. ;* Modifies globals: action_status, meta_status, dial_status, name,    *
  128. ;*                   setup_status, jump, local_logon, new_menu, sysop, *
  129. ;*                   connect_type, newsfile, msg, access_level,        *
  130. ;*                   parmfile                                          *
  131. ;*                                                                     *
  132. ;***********************************************************************
  133. #include "SUBS.WAS"             ;host subroutine library
  134. #include "MAIL.WAS"             ;host mail routines
  135.  
  136. proc main                       ;start of script
  137.  
  138.    if i0 == 999                         ; if HOST.WAX was called from
  139.       distinctive_ring = TRUE          ; distinctive ring, set flag TRUE
  140.    else
  141.       distinctive_ring = FALSE
  142.    endif
  143.  
  144.    setup save                          ; save current setup
  145.  
  146.    set txpace 0                        ; turn off xmit pacing
  147.  
  148.    set aspect spawn on                 ; allow spawning of scripts
  149.  
  150.    fetch ASPECT PATH parmfile          ; build a path to the HOST.PRM
  151.    addfilename parmfile HOSTPRMFILE
  152.  
  153.    strcpy title $PWTITLEBAR            ; save current title so can restore later
  154.  
  155.    if not isfile parmfile              ; if the .PRM doesn't exist
  156.       execute "_HOSTUTL"               ;  run HOSTUTIL.WAS
  157.    endif
  158.  
  159.    taskpath $PWTASK pwhelp_file
  160.    addfilename pwhelp_file "PW2.HLP"
  161.    set aspect helpfile pwhelp_file     ; set the current help file
  162.  
  163.    meta_status=$METAKEYS
  164.    if meta_status                      ; if metakeys are ON
  165.       set metakeys off                 ;  turn them OFF
  166.    endif
  167.  
  168.    quick_status=$QUICKSELECT
  169.    if quick_status                     ; if quick change line is ON
  170.       set quickselect off              ;  turn it OFF
  171.    endif
  172.  
  173.    fetch actionbar TOP action1         ; store the current action bar
  174.    fetch actionbar RIGHT action2       ;  names so they can be put
  175.    fetch actionbar LEFT action3        ;  back later
  176.    fetch actionbar BOTTOM action4
  177.    fetch actionbar FLOAT action5
  178.  
  179.    set actionbar TOP  ""               ; turn all the action bars OFF
  180.    set actionbar RIGHT ""
  181.    set actionbar LEFT ""
  182.    set actionbar BOTTOM ""
  183.    set actionbar FLOAT ""
  184.  
  185.    already_running=FALSE               ; initialize the setup flag
  186.  
  187.    while 1                             ; main/top level loop
  188.       setjmp 1 jump
  189.       HostSetup()            ; set system variables and open HOST.PRM
  190.  
  191.       HostLog("Host mode online.", "")
  192.       pwtitlebar "PROCOMM PLUS - Host"
  193.  
  194.       set aspect rxdata off
  195.  
  196.       OKtoChat = FALSE
  197.       chatflag = FALSE
  198.  
  199.       WaitForCall()                 ; wait for carrier and a connect msg
  200.  
  201.       if local_logon                ; enable/disable menu items
  202.          enable aspmenu 3           ;  depending on logon type
  203.       else
  204.          enable aspmenu 2
  205.          enable aspmenu 1
  206.       endif
  207.  
  208.       enable aspmenu 4
  209.       menushow new_menu
  210.  
  211.       distinctive_ring = FALSE      ; reset distinctive ring flag
  212.  
  213.       if !sysop
  214.          GetUser()                        ; get the user name and password
  215.          if success                       ; If a user logged on,
  216.             if (! $carrier) && (connect_type==MODEM_CON)
  217.                HostLog("Lost Carrier.", "")
  218.                loopwhile
  219.             endif
  220.  
  221.             msg_number = 0                ; reset the message counter
  222.             CallNumber++                  ; Update the current users call count
  223.             LastCalled = $LTIME           ; Update the current users last call time
  224.  
  225.             if fCallBack && !local_logon  ; start the callback procedure if
  226.                ProcessCallBack()          ;  the user has callback enabled
  227.                if ! success
  228.                   loopwhile
  229.                endif
  230.             else
  231.                strfmt msg "Remote user %s online" name
  232.                pwtitlebar msg
  233.                if local_logon
  234.                   HostLog(name, "logged in locally.")
  235.                else
  236.                   HostLog(name, "logged in.")
  237.                endif
  238.             endif
  239.             DisplayFile(newsfile, 23)     ; display the HOST.NWS if it exists
  240.             CheckMail()                   ; check for new mail
  241.             HostMenu()                    ; display the main menu
  242.             if ! success
  243.                loopwhile
  244.             endif
  245.          endif
  246.       else
  247.          name = "SYSOP"                   ; local sysop logon
  248.          security = 2
  249.          strcpy ontime $time
  250.          CheckMail()
  251.          HostMenu()
  252.       endif
  253.    endwhile
  254. endproc
  255.  
  256. ;***********************************************************************
  257. ;*                                                                     *
  258. ;* HOSTMENU                                                            *
  259. ;*                                                                     *
  260. ;* This procedure is the main menu for the remote user.                *
  261. ;*                                                                     *
  262. ;*                                                                     *
  263. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, DISPLAYFILE,        *
  264. ;*        FILELIST, UPLOAD, DOWNLOAD, CHAT, READMAIL, LEAVEMAIL,       *
  265. ;*        HOSTHANGUP, EXITHOST, HOSTGETYN, SWITCHDIR                   *
  266. ;*                                                                     *
  267. ;* Modifies globals: access_level, connect_type, dnldfile, local_logon,*
  268. ;*                   hlpfile, offtime, ontime, goodbye_option, name,   *
  269. ;*                   action_status, meta_status,  dial_status,         *
  270. ;*                   setup_status                                      *
  271. ;*                                                                     *
  272. ;***********************************************************************
  273. proc HostMenu
  274. string key
  275.  
  276.    set txpace 0
  277.    while 1
  278.       OKtoChat = TRUE;
  279.       HostPutS("`r`n")
  280.       HostPutS("`r`n<F>iles      <U>pload      <D>ownload")
  281.       HostPutS("`r`n<H>elp       <T>ime        <C>hat")
  282.       HostPutS("`r`n<R>ead mail  <L>eave mail  Fax <B>ack")
  283.       HostPutS("`r`n`r`n<G>oodbye")
  284.  
  285.       if security==2
  286.          HostPutS("`r`n`r`n<S>witch directory")
  287.          HostPutS("`r`n<A>bort (SHUT DOWN host mode)")
  288.       endif
  289.  
  290.       HostPutS("`r`n`r`nYour Choice? ")
  291.  
  292.       if (! $carrier) && (connect_type==MODEM_CON)
  293.          HostLog("Lost Carrier", "")
  294.          SetFailure()
  295.          exitwhile
  296.       endif
  297.  
  298.       HostGetC(&key)
  299.       OKtoChat = FALSE
  300.       chatflag = FALSE
  301.       if failure
  302.          SetFailure()
  303.          exitwhile
  304.       endif
  305.  
  306.       HostPutS(key)
  307.  
  308.  
  309.       switch key
  310. ;****************
  311. ;* Fax(B)ack    *
  312. ;****************
  313.          case "B"
  314.             if (fFaxBack)
  315.                FaxBack()
  316.             else
  317.                HostPutS("`r`n`r`nYou are not authorized FAX access!`r`n`r`n")
  318.             endif
  319.          endcase
  320.  
  321. ;****************
  322. ;* F)iles       *
  323. ;****************
  324.          case "F"
  325.             if security!=2
  326.                fetch ASPECT PATH dnldfile
  327.                addfilename dnldfile HOSTDNLDFILE
  328.                DisplayFile(dnldfile, 23)
  329.                if ! success
  330.                   FileList()
  331.                endif
  332.             else
  333.                FileList()
  334.             endif
  335.          endcase
  336. ;****************
  337. ;* U)pload      *
  338. ;****************
  339.          case "U"
  340.             if local_logon
  341.                HostPutS("`r`n`r`nYou can't transfer files during a local logon!`r`n`r`n")
  342.             else
  343.                if security==0
  344.                   HostPutS("`r`n`r`nYou aren't authorized to transfer files!`r`n`r`n")
  345.                else
  346.                   Upload()
  347.                endif
  348.             endif
  349.          endcase
  350. ;****************
  351. ;* D)ownload    *
  352. ;****************
  353.          case "D"
  354.             if local_logon
  355.                HostPutS("`r`n`r`nYou can't transfer files during a local logon!`r`n`r`n")
  356.             else
  357.                if security==0
  358.                   HostPutS("`r`n`r`nYou aren't authorized to transfer files!`r`n`r`n")
  359.                else
  360.                   Download()
  361.                endif
  362.             endif
  363.          endcase
  364. ;****************
  365. ;* H)elp        *
  366. ;****************
  367.          case "H"
  368.             fetch ASPECT PATH hlpfile
  369.             addfilename hlpfile HOSTHLPFILE
  370.             DisplayFile(hlpfile, 23)
  371.             if ! success
  372.                HostPutS("`r`nHelp not available.`r`n")
  373.             endif
  374.          endcase
  375. ;****************
  376. ;* T)ime        *
  377. ;****************
  378.          case "T"
  379.             strcpy offtime $time
  380.             HostPutS("`r`n`r`nOnline at: ")
  381.             HostPutS(ontime)
  382.             HostPutS("`r`nIt is now: ")
  383.             HostPuts(offtime)
  384.             HostPutS("`r`n`r`n")
  385.          endcase
  386. ;****************
  387. ;* C)hat        *
  388. ;****************
  389.          case "C"
  390.             if local_logon
  391.                HostPutS("`r`n`r`nYou can't chat during a local logon!`r`n`r`n")
  392.             else
  393.                Chat()
  394.                chatflag = FALSE
  395.             endif
  396.          endcase
  397. ;****************
  398. ;* R)ead Mail   *
  399. ;****************
  400.          case "R"
  401.             ReadMail()
  402.             if msg_number != 0
  403.                LastMsgRead = msg_number   ; Update the current users last msg read
  404.             endif
  405.          endcase
  406. ;****************
  407. ;* L)eave Mail  *
  408. ;****************
  409.          case "L"
  410.             LeaveMail(0,"", "")
  411.             if ! success
  412.                SetFailure()
  413.                return
  414.             endif
  415.          endcase
  416. ;****************
  417. ;* G)oodbye     *
  418. ;****************
  419.          case "G"                         ;Goodbye
  420.             UpdateUserStats()
  421.             strcpy offtime $time
  422.             HostPutS("`r`n`r`nOnline at: ")
  423.             HostPutS(ontime)
  424.             HostPutS("`r`nIt is now: ")
  425.             HostPuts(offtime)
  426.             HostPutS("`r`n`r`n")
  427.  
  428.             if connect_type==MODEM_CON
  429.                HostHangup()
  430.             endif
  431.             if goodbye_option==1
  432.                clear
  433.                ExitHost()
  434.             endif
  435.             HostLog(name, "logged out.")
  436.             exitwhile
  437.          endcase
  438. ;****************
  439. ; A)bort        *
  440. ;****************
  441.          case "A"
  442.             if security==2
  443.                HostPutS("`r`n`r`nAbort Host Mode (Y/N)?")
  444.                HostGetYN()
  445.                if success
  446.                   UpdateUserStats()
  447.                   HostPutS("`r`nAborting ...`r`n")
  448.                   HostLog(name, "remote shutdown.")
  449.                   if connect_type==MODEM_CON
  450.                      HostPutS("`r`nHangup line (Y/N)?")
  451.                      HostGetYN()
  452.                      if success
  453.                         HostHangup()
  454.                         ;;set autoanswer off
  455.                         setup restore
  456.                      else 
  457.                         set autoanswer OldAnswerMode
  458.                      endif
  459.                   endif
  460.                   if meta_status
  461.                      set metakeys on
  462.                    endif
  463.                   if quick_status
  464.                      set quickselect on
  465.              
  466.                    endif
  467.  
  468.                   clear
  469.                   set actionbar TOP    action1
  470.                   set actionbar RIGHT  action2
  471.                   set actionbar LEFT   action3
  472.                   set actionbar BOTTOM action4
  473.                   set actionbar FLOAT  action5
  474.                   pwtitlebar title           ; restore title from start-up
  475.                   halt
  476.                endif
  477.             endif
  478.          endcase
  479. ;****************
  480. ; S)witch       *
  481. ;****************
  482.          case "S"
  483.             if security==2
  484.                SwitchDir()
  485.             endif
  486.          endcase
  487. ;***************
  488.       endswitch
  489.    endwhile
  490. endproc
  491.  
  492. ;***********************************************************************
  493. ;*                                                                     *
  494. ;* FILELIST                                                            *
  495. ;*                                                                     *
  496. ;* This procedure displays a file directory for the user like the      *
  497. ;* DOS "DIR" command.                                                  *
  498. ;*                                                                     *
  499. ;* Calls: HOSTPUTS, HOSTGETS, HOSTGETC                                 *
  500. ;*                                                                     *
  501. ;* Modifies globals: access_level, dnload_path,  msg                   *
  502. ;*                                                                     *
  503. ;***********************************************************************
  504. proc FileList
  505. string filespec, filepath, key, dirflag="<DIR>"
  506. integer again=0, linenum=1, maxlen=40
  507.  
  508.    HostPutS("`r`nEnter FILE SPEC: (Carriage Return = *.*)`r`n> ")
  509.    HostGetS(&filespec, maxlen, DISP)
  510.  
  511.    strcmp filespec ""
  512.    if success
  513.       filespec="*.*"
  514.    endif
  515.  
  516.  
  517.    if security!=2
  518.  
  519.       strfind filespec ":"                ; don't let regular users look at
  520.       if success                          ;  another drive
  521.          strfmt msg "`r`n%s <==Invalid character in filespec!`r`n" filespec
  522.          HostPutS(msg)
  523.          SetFailure()
  524.          return
  525.       endif
  526.  
  527.       strfind filespec "\"                ; don't let regular users look at
  528.       if success                          ;  another path
  529.          strfmt msg "`r`n%s <==Invalid character in filespec!`r`n" filespec
  530.          HostPutS(msg)
  531.          SetFailure()
  532.          return
  533.       endif
  534.  
  535.       if fDirectory
  536.          strcpy filepath UserDnloadPath
  537.          addfilename filepath filespec
  538.       else
  539.          strcpy filepath hostdnload_path
  540.          addfilename filepath filespec
  541.       endif
  542.  
  543.    else
  544.       if strfind filespec "\"
  545.          strcpy filepath filespec
  546.       else
  547.          getdir 0 filepath
  548.          addfilename filepath filespec
  549.       endif
  550.    endif
  551.  
  552.    findfirst filepath "D"
  553.    if success
  554.       strfind $FATTR "D"
  555.       if success
  556.          strfmt msg "`r`n`r`n %-12s  %8s  %9s  %s`r`n" $FILENAME dirflag $FDATE $FTIME
  557.       else
  558.          strfmt msg "`r`n`r`n %-12s  %8ld  %9s  %s`r`n" $FILENAME $FSIZE $FDATE $FTIME
  559.       endif
  560.       HostPutS(msg)
  561.       linenum++
  562.       again=1
  563.    else
  564.       HostPutS("`r`n`r`nNo files found.`r`n")
  565.    endif
  566.    while again
  567.       if linenum==23
  568.          linenum=1
  569.          HostPutS("<CR> to continue, <S> to stop")
  570.          HostGetC(&key)                   ; get user input
  571.          HostPutS("`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b")
  572.          strupr key
  573.          strcmp key "S"                   ; if the user says NO
  574.  
  575.          if success
  576.             exitwhile
  577.          endif
  578.       endif
  579.  
  580.       findnext
  581.       if success
  582.          strfind $FATTR "D"
  583.          if success
  584.             strfmt msg " %-12s  %8s  %9s  %s`r`n" $FILENAME dirflag $FDATE $FTIME
  585.          else
  586.             strfmt msg " %-12s  %8ld  %9s  %s`r`n" $FILENAME $FSIZE $FDATE $FTIME
  587.          endif
  588.          HostPutS(msg)
  589.          linenum++
  590.       else
  591.          HostPutS("`r`n-End of list.-`r`n")
  592.          exitwhile
  593.       endif
  594.    endwhile
  595. endproc
  596.  
  597. ;***********************************************************************
  598. ;*                                                                     *
  599. ;* UPLOAD                                                              *
  600. ;*                                                                     *
  601. ;* This procedure provides a menu for the remote user to send files    *
  602. ;* to the host system.                                                 *
  603. ;*                                                                     *
  604. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, GETFNAME,           *
  605. ;*        ISWILDCARD, TXWAIT                                           *
  606. ;*                                                                     *
  607. ;* Modifies globals: connect_type, status, msg, name                   *
  608. ;*                                                                     *
  609. ;***********************************************************************
  610. proc upload
  611. string filename, choice
  612. string xferbegin = "`r`nBegin your transfer procedure...  (CTRL-X aborts)`r`n"
  613. integer calledfrom = 0
  614.  
  615.    while 1
  616.       HostPutS("`r`n")
  617.       HostPutS("`r`n<K> Kermit      <X> Xmodem")
  618.       HostPutS("`r`n<O> 1K-Xmodem   <E> 1K-Xmodem-G")
  619.       HostPutS("`r`n<Y> Ymodem      <G> Ymodem-G")
  620.       HostPutS("`r`n<Z> Zmodem      <H> HS/Link")
  621.       HostPutS("`r`n")
  622.       HostPutS("`r`nYour choice? ")
  623.  
  624.       if (! $carrier) && (connect_type==MODEM_CON)
  625.          HostLog("Lost Carrier", "")
  626.          SetFailure()
  627.          exitwhile
  628.       endif
  629.       HostGetC(&choice)
  630.       if failure
  631.          exitwhile
  632.       endif
  633.       HostPutS(choice)
  634.  
  635.       switch choice 
  636. ;****************
  637. ;* K)ermit      *
  638. ;****************
  639.          case "K"
  640.             GetFname(&filename, calledfrom)
  641.             if failure
  642.                exitwhile
  643.             endif
  644.             HostPutS(xferbegin)
  645.             txwait()
  646.          getfile kermit
  647.          endcase
  648. ;****************
  649. ;* X)modem      *
  650. ;****************
  651.          case "X"
  652.             GetFname(&filename, calledfrom)
  653.             if failure
  654.                exitwhile
  655.             endif
  656.             IsWildcard(&filename)
  657.             if failure
  658.                exitwhile
  659.             endif
  660.             HostPutS(xferbegin)
  661.             txwait()
  662.          getfile xmodem filename
  663.          endcase
  664. ;****************
  665. ;* Z)modem      *
  666. ;****************
  667.          case "Z"
  668.             GetFname(&filename, calledfrom)
  669.             if failure
  670.                exitwhile
  671.             endif
  672.             HostPutS(xferbegin)
  673.             txwait()
  674.          getfile zmodem
  675.          endcase
  676. ;****************
  677. ;* Y)modem      *
  678. ;****************
  679.          case "Y"
  680.             GetFname(&filename, calledfrom)
  681.             if failure
  682.                exitwhile
  683.             endif
  684.             HostPutS(xferbegin)
  685.             txwait()
  686.          getfile ymodem
  687.          endcase
  688. ;****************
  689. ;* O) 1K Xmodem *
  690. ;****************
  691.          case "O"
  692.             GetFname(&filename, calledfrom)
  693.             if failure
  694.                exitwhile
  695.             endif
  696.             IsWildcard(&filename)
  697.             if failure
  698.                exitwhile
  699.             endif
  700.             HostPutS(xferbegin)
  701.             txwait()
  702.          getfile 1kxmodem filename
  703.          endcase
  704. ;****************
  705. ;* E) 1K XmodemG*
  706. ;****************
  707.          case "E"
  708.             GetFname(&filename, calledfrom)
  709.             if failure
  710.                exitwhile
  711.             endif
  712.             IsWildcard(&filename)
  713.             if failure
  714.                exitwhile
  715.             endif
  716.             HostPutS(xferbegin)
  717.             txwait()
  718.          getfile 1kxmodemg filename
  719.          endcase
  720. ;****************
  721. ;* Y)modem-G    *
  722. ;****************
  723.          case "G"
  724.             GetFname(&filename, calledfrom)
  725.             if failure
  726.                exitwhile
  727.             endif
  728.             HostPutS(xferbegin)
  729.             txwait()
  730.          getfile ymodemg
  731.          endcase
  732. ;****************
  733. ;* H)S/Link     *
  734. ;****************
  735.          case "H"
  736.             GetFname(&filename, calledfrom)
  737.             if failure
  738.                exitwhile
  739.             endif
  740.             HostPutS(xferbegin)
  741.             txwait()
  742.          getfile "HSLINK"
  743.          endcase
  744. ;****************
  745. ;* Default      *
  746. ;****************
  747.          default
  748.             exitwhile
  749.          endcase
  750.       endswitch
  751.  
  752.       pause 1
  753.  
  754.       status=$XFERSTATUS
  755.  
  756.       while status==1
  757.                                           ;loop here while xfer is going on
  758.          status=$XFERSTATUS
  759.          yield
  760.       endwhile
  761.  
  762.       if status==2
  763.          HostPutS("`r`nTRANSFER COMPLETE.`r`n")
  764.          strfmt msg "uploaded %s successfully." filename
  765.          HostLog(name, msg)               ;log a sucessful upload
  766.       elseif status==3
  767.          ;log a failed upload
  768.          pause 2
  769.          rxflush
  770.          txflush
  771.          HostPutS("`r`nTRANSFER ABORTED!`r`n`r`n")
  772.          strfmt msg "failed to upload %s." filename
  773.          HostLog(name, msg)               ;log a sucessful upload
  774.       endif
  775.       exitwhile
  776.    endwhile
  777. endproc
  778.  
  779. ;***********************************************************************
  780. ;*                                                                     *
  781. ;* DOWNLOAD                                                            *
  782. ;*                                                                     *
  783. ;* This procedure provides a menu for the remote user to receive       *
  784. ;* files.                                                              *
  785. ;*                                                                     *
  786. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, GETFNAME,           *
  787. ;*        ISWILDCARD, TXWAIT                                           *
  788. ;*                                                                     *
  789. ;* Modifies globals: connect_type, status, msg, name                   *
  790. ;*                                                                     *
  791. ;***********************************************************************
  792. proc download
  793.  
  794. string filename, choice
  795. string xferbegin = "`r`nBegin your transfer procedure...  (CTRL-X aborts)`r`n"
  796. integer calledfrom = 1
  797.  
  798.    while 1
  799.       HostPutS("`r`n")
  800.       HostPutS("`r`n<K> Kermit      <X> Xmodem")
  801.       HostPutS("`r`n<O> 1K-Xmodem   <E> 1K-Xmodem-G")
  802.       HostPutS("`r`n<Y> Ymodem      <G> Ymodem-G")
  803.       HostPutS("`r`n<Z> Zmodem      <H> HS/Link")
  804.       HostPutS("`r`n")
  805.       HostPutS("`r`nYour choice? ")
  806.  
  807.       if (! $carrier) && (connect_type==MODEM_CON)
  808.          HostLog("Lost Carrier", "")
  809.          SetFailure()
  810.          exitwhile
  811.       endif
  812.  
  813.       HostGetC(&choice)
  814.       if failure
  815.          exitwhile
  816.       endif
  817.  
  818.       HostPutS(choice)
  819.  
  820.       switch choice 
  821. ;****************
  822. ;* K)ermit      *
  823. ;****************
  824.          case "K"
  825.             GetFname(&filename, calledfrom)
  826.             if failure
  827.                exitwhile
  828.             endif
  829.             HostPutS(xferbegin)
  830.             txwait()
  831.          sendfile kermit filename
  832.          endcase
  833. ;****************
  834. ;* X)modem      *
  835. ;****************
  836.          case "X"
  837.             GetFname(&filename, calledfrom)
  838.             if failure
  839.                exitwhile
  840.             endif
  841.             IsWildcard(&filename)
  842.             if failure
  843.                exitwhile
  844.             endif
  845.             HostPutS(xferbegin)
  846.             txwait()
  847.          sendfile xmodem filename
  848.          endcase
  849. ;****************
  850. ;* Z)modem      *
  851. ;****************
  852.          case "Z"
  853.             GetFname(&filename, calledfrom)
  854.             if failure
  855.                exitwhile
  856.             endif
  857.             HostPutS(xferbegin)
  858.             txwait()
  859.          sendfile zmodem filename
  860.          endcase
  861. ;****************
  862. ;* Y)modem      *
  863. ;****************
  864.          case "Y"
  865.             GetFname(&filename, calledfrom)
  866.             if failure
  867.                exitwhile
  868.             endif
  869.             HostPutS(xferbegin)
  870.             txwait()
  871.          sendfile ymodem filename
  872.          endcase
  873. ;****************
  874. ;* O) 1K Xmodem *
  875. ;****************
  876.          case "O"
  877.             GetFname(&filename, calledfrom)
  878.             if failure
  879.                exitwhile
  880.             endif
  881.             IsWildcard(&filename)
  882.             if failure
  883.                exitwhile
  884.             endif
  885.  
  886.             HostPutS(xferbegin)
  887.             txwait()
  888.          sendfile 1kxmodem filename
  889.          endcase
  890. ;****************
  891. ;* E) 1K XmodemG*
  892. ;****************
  893.          case "E"
  894.             GetFname(&filename, calledfrom)
  895.             if failure
  896.                exitwhile
  897.             endif
  898.             IsWildcard(&filename)
  899.             if failure
  900.                exitwhile
  901.             endif
  902.             HostPutS(xferbegin)
  903.             txwait()
  904.          sendfile 1kxmodemg filename
  905.          endcase
  906. ;****************
  907. ;* Y)modem-G    *
  908. ;****************
  909.          case "G"
  910.             GetFname(&filename, calledfrom)
  911.             if failure
  912.                exitwhile
  913.             endif
  914.             HostPutS(xferbegin)
  915.             txwait()
  916.          sendfile ymodemg filename
  917.          endcase
  918. ;****************
  919. ;* H)s/Link     *
  920. ;****************
  921.          case "H"
  922.             GetFname(&filename, calledfrom)
  923.             if failure
  924.                exitwhile
  925.             endif
  926.             HostPutS(xferbegin)
  927.             txwait()
  928.          sendfile "HSLINK" filename
  929.          endcase
  930. ;****************
  931. ;* Default      *
  932. ;****************
  933.          default
  934.             exitwhile
  935.          endcase
  936.       endswitch
  937.  
  938.       pause 1
  939.  
  940.       status=$XFERSTATUS
  941.  
  942.       while status==1
  943.          ;loop here while xfer is going on
  944.          yield
  945.          status=$XFERSTATUS
  946.       endwhile
  947.  
  948.       rxflush
  949.       txflush
  950.       pause 1
  951.  
  952.       if status==2
  953.          HostPutS("`r`nTRANSFER COMPLETE.`r`n")
  954.          strfmt msg "downloaded %s successfully." filename
  955.          HostLog(name, msg)               ;log a sucessful download
  956.       elseif status==3
  957.          HostPutS("`r`nTRANSFER ABORTED!`r`n`r`n")
  958.          strfmt msg "failed to download %s." filename
  959.          HostLog(name, msg)               ;log a sucessful download
  960.       endif
  961.       exitwhile
  962.    endwhile
  963. endproc
  964.  
  965. ;***********************************************************************
  966. ;*                                                                     *
  967. ;* GETFNAME                                                            *
  968. ;*                                                                     *
  969. ;* This procedure validates a filename for upload or download.         *
  970. ;*                                                                     *
  971. ;* Input:  string fname (filename to be validated)                     *
  972. ;*         integer calledfrom (upload or download menu)                *
  973. ;*                                                                     *
  974. ;* Return: Success for vaild filename, Failure on invalid filename     *
  975. ;*                                                                     *
  976. ;*                                                                     *
  977. ;* Notes:  Keeps level 1 users from downloading any file they want.    *
  978. ;*                                                                     *
  979. ;* Calls:  HOSTPUTS, HOSTGETS, SETFAILURE, SETSUCCESS, HOSTGETYN       *                                                     *
  980. ;*                                                                     *
  981. ;* Modifies globals: dnload_path,  access_level, msg                   *
  982. ;*                                                                     *
  983. ;*                                                                     *
  984. ;***********************************************************************
  985. proc GetFname
  986. param string fname
  987. param integer calledfrom
  988. string filepath
  989. integer len
  990.  
  991.  
  992.    if calledfrom==0                       ; user is uploading
  993.  
  994.       if fDirectory
  995.          filepath=UserUploadPath
  996.       else
  997.          filepath=hostupload_path
  998.       endif
  999.    else                                   ; user is downloading
  1000.       if fDirectory
  1001.          filepath=UserDnloadPath
  1002.       else
  1003.          filepath=hostdnload_path
  1004.       endif
  1005.    endif
  1006.  
  1007.    HostPutS("`r`n`r`nFile name? ")
  1008.  
  1009.    HostGetS(&fname, 20, DISP)             ; get the filename
  1010.    if failure
  1011.       SetFailure()
  1012.       return
  1013.    endif
  1014.  
  1015.    strcmp fname ""                        ; make sure user didn't hit
  1016.    if success                             ;  ENTER for the filename
  1017.       SetFailure()
  1018.       return
  1019.    endif
  1020.  
  1021.    strlen fname len
  1022.    if len>12
  1023.       HostPutS("`r`nFilename is too long!`r`n`r`n")
  1024.       SetFailure()
  1025.       return
  1026.    endif
  1027.  
  1028.    strupr fname                           ; uppercase the filename
  1029.    HostPutS("`r`n")
  1030.  
  1031.    strfind fname ":"                      ; don't let regular users upload to
  1032.    if success                             ;  another drive
  1033.       strfmt msg "`r`n%s <==Invalid character in filename!`r`n" fname
  1034.       HostPutS(msg)
  1035.       SetFailure()
  1036.       return
  1037.    endif
  1038.  
  1039.    strfind fname "\"                      ; don't let regular users upload to
  1040.    if success                             ;  another path
  1041.       strfmt msg "`r`n%s <==Invalid character in filename!`r`n" fname
  1042.       HostPutS(msg)
  1043.       SetFailure()
  1044.       return
  1045.    endif
  1046.  
  1047.    if security!=2
  1048.       if calledfrom == 0
  1049.          set dnldpath filepath
  1050.       else
  1051.          set upldpath filepath
  1052.       endif
  1053.       addfilename filepath fname          ; build a fullpath for the filename
  1054.       fname=filepath
  1055.    else
  1056.       getdir 0 filepath                   ; level 2 users will upload to current
  1057.       if calledfrom == 0                  ;  directory
  1058.          set dnldpath filepath
  1059.       else
  1060.          set upldpath filepath
  1061.       endif
  1062.       addfilename filepath fname          ; the current directory
  1063.       fname=filepath
  1064.    endif
  1065.  
  1066.    findfirst fname                        ; find the file to see if it exist
  1067.    if ! success
  1068.       if calledfrom == 1                  ; if user is downloading
  1069.          HostPutS("`r`nFile not found!`r`n")
  1070.          SetFailure()
  1071.          return
  1072.       else
  1073.          SetSuccess()
  1074.          return
  1075.       endif
  1076.    else
  1077.       if calledfrom == 0                  ; user is uploading
  1078.          if security !=2
  1079.             HostPutS("`r`nFile already exists!`r`n")
  1080.             SetFailure()
  1081.             return
  1082.          else
  1083.             HostputS("`r`nFile exists, overwrite? ")
  1084.             HostGetYN()
  1085.             if success
  1086.                HostPutS("`r`n")
  1087.                delfile fname
  1088.                if ! success
  1089.                   HostPutS("`r`n`r`nCan't delete file!`r`n")
  1090.                   SetFailure()
  1091.                   return
  1092.                endif
  1093.                SetSuccess()
  1094.                return
  1095.             else
  1096.                SetFailure()
  1097.                return
  1098.             endif
  1099.             HostPutS("`r`n")
  1100.             SetFailure()
  1101.             return
  1102.          endif
  1103.       endif
  1104.       SetSuccess()
  1105.    endif
  1106.    HostPutS("`r`n")
  1107. endproc
  1108.  
  1109. ;***********************************************************************
  1110. ;*                                                                     *
  1111. ;* ISWILDCARD                                                          *
  1112. ;*                                                                     *
  1113. ;* This procedure keeps users from specifying wildcard characters in   *
  1114. ;* a filename for transfer protocols that do no support them.          *
  1115. ;*                                                                     *
  1116. ;* Input:  string fname (filename to validate)                         *
  1117. ;*                                                                     *
  1118. ;* Return: Success for valid filename, Failure otherwise               *
  1119. ;*                                                                     *
  1120. ;* Calls:  HOSTPUTS, SETFAILURE, SETSUCCESS                            *
  1121. ;*                                                                     *
  1122. ;* Modifies globals: none                                              *
  1123. ;*                                                                     *
  1124. ;***********************************************************************
  1125. proc IsWildcard
  1126. param string fname
  1127. string error = "`r`nNo wildcards allowed!`r`n"
  1128.  
  1129.    strfind fname "*"
  1130.    if success
  1131.       HostPutS(error)
  1132.       SetFailure()
  1133.       return
  1134.    endif
  1135.  
  1136.    strfind fname "?"
  1137.    if success
  1138.       HostPutS(error)
  1139.       SetFailure()
  1140.       return
  1141.    endif
  1142.  
  1143.    SetSuccess()
  1144. endproc
  1145.  
  1146. ;***********************************************************************
  1147. ;*                                                                     *
  1148. ;* SWITCHDIR                                                           *
  1149. ;*                                                                     *
  1150. ;* This procedure allows a level 2 user to change the working          *
  1151. ;* directory.                                                          *
  1152. ;*                                                                     *
  1153. ;* Calls: HOSTPUTS, HOSTGETS, ISWILDCARD, HOSTLOG                      *
  1154. ;*                                                                     *
  1155. ;* Modifies globals: msg, name                                         *
  1156. ;*                                                                     *
  1157. ;***********************************************************************
  1158. proc SwitchDir
  1159. string filepath, newpath
  1160.  
  1161.    getdir 0 filepath
  1162.    strfmt msg "`r`nCurrent directory is %s`r`n" filepath
  1163.    HostPutS(msg)
  1164.    HostPutS("Change to what directory? ")
  1165.    HostGetS(&newpath, 50, DISP)
  1166.    if success
  1167.       IsWildcard(newpath)
  1168.       HostPuts("`r`n")
  1169.       if chdir newpath
  1170.          strfmt msg "Changed directory to %s." newpath
  1171.       else
  1172.          strfmt msg "Error changing to %s !" newpath
  1173.       endif
  1174.       HostPuts(msg)
  1175.       HostPuts("`r`n")
  1176.       HostLog(name, msg)
  1177.    endif
  1178. endproc
  1179.  
  1180. ;***********************************************************************
  1181. ;*                                                                     *
  1182. ;* HOSTLOG                                                             *
  1183. ;*                                                                     *
  1184. ;* This procedure puts an activity message into the HOST.LOG file.     *
  1185. ;*                                                                     *
  1186. ;* Calls: HOSTMSGBOX                                                   *
  1187. ;*                                                                     *
  1188. ;* Modifies globals: logfile, msg                                      *
  1189. ;*                                                                     *
  1190. ;***********************************************************************
  1191. proc HostLog
  1192. param string activity1
  1193. param string activity2
  1194.  
  1195.    isfile logfile
  1196.    if ! success                       ;if new file put header at top
  1197.       fopen 1 logfile CREATE TEXT
  1198.       if success
  1199.          fputs 1 "  DATE      TIME             ACTIVITY"
  1200.          fputs 1 "--------  ----------   --------------------------------"
  1201.          fclose 1
  1202.       else
  1203.          HostMsgBox("Can't create HOST.LOG file!")
  1204.          return
  1205.       endif
  1206.    endif
  1207.  
  1208.    fopen 1 logfile WRITE TEXT
  1209.    if ! success
  1210.       HostMsgBox("Can't open HOST.LOG file!")
  1211.       return
  1212.    endif
  1213.    fseek 1 0 2
  1214.    strfmt msg "%s  %s   %s %s" $DATE $TIME activity1 activity2
  1215.    fputs 1 msg
  1216.    fclose 1
  1217. endproc
  1218.  
  1219. ;***********************************************************************
  1220. ;*                                                                     *
  1221. ;* PROCESSCALLBACK                                                     *
  1222. ;*                                                                     *
  1223. ;* Calls a remote site and prompts the user for a password.            *
  1224. ;*                                                                     *
  1225. ;***********************************************************************
  1226. proc ProcessCallBack
  1227. integer maxcalls, tries = 0
  1228.       
  1229.    pswrd = ""                             ; reset the password to NULL
  1230.    
  1231.    ;dialcreate "PWHOST.DIR"
  1232.    ;dialload   "PWHOST.DIR"   
  1233.    
  1234.    HostPutS("`r`n`r`nHangup now and prepare your")
  1235.    HostPutS("`r`nmodem to answer a data call.`r`n`r`n`r`n")
  1236.    set aspect rxdata off
  1237.    pause 2
  1238.    HostHangup()
  1239.    pause 10
  1240.  
  1241.    dialnumber DATA CallBackNum
  1242.    fetch dialdir maxdial maxcalls
  1243.    set dialdir maxdial 4
  1244.    while $DIALING
  1245.    endwhile
  1246.  
  1247.    if !$CARRIER
  1248.       HostLog(LoginName, "failed callback connection.")
  1249.       SetFailure()
  1250.       return
  1251.    endif
  1252.  
  1253.    pause 5
  1254.    rxflush
  1255.    txflush
  1256.       
  1257.    set dialdir maxdial maxcalls
  1258.    set aspect rxdata on
  1259.    GetUserPswd()  
  1260.    
  1261.    while tries < 3
  1262.       strcmp pswrd Passwrd
  1263.       if success
  1264.          SetSuccess()
  1265.          return
  1266.       else
  1267.          GetUserPswd()  
  1268.          tries++
  1269.       endif
  1270.    endwhile
  1271.    HostPutS("`r`n`r`nPassword incorrect.`r`n")
  1272.    if connect_type==MODEM_CON
  1273.       HostHangup()
  1274.    endif
  1275.    HostLog(LoginName, "failed callback password check.")
  1276.    SetFailure()
  1277. endproc
  1278.  
  1279. ;***********************************************************************
  1280. ;*                                                                     *
  1281. ;* FAXBACK                                                             *
  1282. ;*                                                                     *
  1283. ;* This procedure sends a FAX to a remote site.                        *
  1284. ;*                                                                     *
  1285. ;***********************************************************************
  1286. proc FaxBack
  1287.  
  1288. integer again=0, linenum=1
  1289. string choice, filespec
  1290. string ToName, filename
  1291. integer call_type
  1292. string country, area, number, temp, timestr
  1293. long sendtime
  1294.  
  1295.    while 1
  1296.       HostPuts("`r`n`r`n")
  1297.       HostPutS("<L>ist FAX files`r`n")
  1298.       HostPutS("<R>equest Host to send a FAX`r`n")
  1299.       HostPutS("<Q>uit`r`n`r`n? ")
  1300.       HostGetC(&choice)
  1301.       if ! success
  1302.          SetFailure()
  1303.          return
  1304.       endif
  1305.       HostPuts(choice)
  1306.       HostPuts("`r`n")
  1307.       strupr choice
  1308.       switch choice
  1309.          case "L"
  1310.             strcpy filespec hostfax_path
  1311.             addfilename filespec "*.FAX"
  1312.             findfirst filespec
  1313.             if success
  1314.                strfmt msg "`r`n`r`n %-12s  %9s  %s`r`n" $FILENAME $FDATE $FTIME
  1315.                HostPutS(msg)
  1316.                linenum++
  1317.                again=1
  1318.             else
  1319.                HostPutS("`r`n`r`nNo FAX files found.`r`n")
  1320.             endif
  1321.  
  1322.             while again
  1323.                if linenum==23
  1324.                   linenum=1
  1325.                   HostPutS("<CR> to continue, <S> to stop")
  1326.                   HostGetC(&choice)  ; get user input
  1327.                   HostPutS("`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b`b")
  1328.                   strupr choice
  1329.                   strcmp choice "S"       ; if the user says NO
  1330.                   if success
  1331.                      exitwhile
  1332.                   endif
  1333.                endif
  1334.  
  1335.                findnext
  1336.                if success
  1337.                   strfmt msg " %-12s  %9s  %s`r`n" $FILENAME $FDATE $FTIME
  1338.                   HostPutS(msg)
  1339.                   linenum++
  1340.                else
  1341.                   HostPutS("`r`n-End of FAX list.-`r`n")
  1342.                   exitwhile
  1343.                endif
  1344.             endwhile
  1345.          endcase
  1346.  
  1347.          case "R"
  1348.                                           ;Get .FAX file name
  1349.             HostPutS("`r`n`r`nFile name: ")
  1350.             HostGetS(&filespec, 12, DISP)
  1351.             if ! success
  1352.                SetFailure()
  1353.                return
  1354.             endif
  1355.             strcpy filename hostfax_path
  1356.             addfilename filename filespec
  1357.             if not isfile filename
  1358.                HostPuts("`r`nFile not found!`r`n")
  1359.                loopwhile
  1360.             endif
  1361.  
  1362.                                           ;Get the receivers name
  1363.             HostPutS("`r`nRecipient's name: ")
  1364.             HostGetS(&ToName, 45, DISP)
  1365.             if ! success
  1366.                SetFailure()
  1367.                return
  1368.             endif
  1369.  
  1370.                                           ;Get call type:
  1371.                                           ;  1 - International
  1372.                                           ;  2 - Long Distance
  1373.                                           ;  3 - Local
  1374.                                           ;  4 - Internal
  1375.  
  1376.                                           ;International call?
  1377.                                           ; If so, get country code
  1378.                                           ; Get area/city code
  1379.                                           ; Get phone number
  1380.  
  1381.             HostPuts("`r`n`r`nSelect call type for recipient's number:`r`n")
  1382.             HostPutS("`t1 - International`r`n")
  1383.             HostPutS("`t2 - Long Distance`r`n")
  1384.             HostPutS("`t3 - Local`r`n")
  1385.             HostPutS("`t4 - Internal`r`n`r`n")
  1386.             HostPutS("Choice :")
  1387.  
  1388.             HostGetS(&temp, 1, DISP)
  1389.             if ! success
  1390.                SetFailure()
  1391.                return
  1392.             endif
  1393.  
  1394.             HostPuts("`r`n")
  1395.  
  1396.             atoi temp call_type
  1397.  
  1398.             switch call_type
  1399.                case 1
  1400.                   HostPutS("`r`nCountry Code : ")
  1401.                   HostgetS(&country, 12, DISP)
  1402.                   if ! success
  1403.                      SetFailure()
  1404.                      return
  1405.                   endif
  1406.                   HostPutS("`r`n")
  1407.                case 2
  1408.                case 3
  1409.                   HostPutS("`r`nArea/City Code : ")
  1410.                   HostgetS(&area, 7, DISP)
  1411.                   if ! success
  1412.                      SetFailure()
  1413.                      return
  1414.                   endif
  1415.                   HostPutS("`r`n")
  1416.                case 4
  1417.                   HostPutS("`r`nNumber : ")
  1418.                   HostgetS(&number, 25, DISP)
  1419.                   if ! success
  1420.                      SetFailure()
  1421.                      return
  1422.                   endif
  1423.                   HostPutS("`r`n")
  1424.                endcase
  1425.                default
  1426.                   loopwhile
  1427.                endcase
  1428.             endswitch
  1429.  
  1430.                                           ;Create Dialing Directory entry
  1431.             dialadd FAX ToName
  1432.             if ! success
  1433.                strcat ToName "-01"
  1434.                dialadd FAX ToName
  1435.                if ! success
  1436.                   HostLog("Error adding dial entry ", ToName)
  1437.                   loopwhile
  1438.                endif
  1439.             endif
  1440.  
  1441.             set dialentry access ToName
  1442.             set dialentry areacode area
  1443.             set dialentry countrycode country
  1444.             set dialentry phonenumber FAX number
  1445.             switch call_type
  1446.                case 1
  1447.                   set dialentry calltype INTL
  1448.                endcase
  1449.                case 2
  1450.                   set dialentry calltype LONGDISTANCE
  1451.                endcase
  1452.                case 3
  1453.                   set dialentry calltype LOCAL
  1454.                endcase
  1455.                case 4
  1456.                   set dialentry calltype INTERNAL
  1457.                endcase
  1458.                default
  1459.                   loopwhile
  1460.                endcase
  1461.             endswitch
  1462.  
  1463.             sendtime = $LTIME + 180
  1464.                                           ;FAXSEND command
  1465.  
  1466.             faxsend DIALDIR ToName sendtime single filename
  1467.  
  1468.                                           ;Remove dialdir entry
  1469.  
  1470.             dialdelete FAX entry ToName
  1471.             ltimestring sendtime timestr
  1472.             strfmt temp "`r`nFAX scheduled to be sent at %s`r`n`r`n", timestr
  1473.             HostPutS(temp)
  1474.             ;Done
  1475.          endcase
  1476.  
  1477.          case "Q"
  1478.             return
  1479.          endcase
  1480.  
  1481.       endswitch
  1482.    endwhile
  1483.  
  1484. endproc
  1485. ;**** End of HOST.WAS ****
  1486.